perm filename QUADO.F4[TMP,LCS] blob sn#108376 filedate 1974-09-17 generic text, type T, neo UTF8
00100		SUBROUTINE QUADO(P,IPAR,NL,XF,YF)
00200		DIMENSION P(30),FAC(4)
00300		EQUIVALENCE(XA,FAC(1)),(XB,FAC(2)),(XC,FAC(3)),(XD,FAC(4))
00310		DATA SQ200/14.142/
00400		XC=0
00500		XD=0
00550		IF(XF.EQ.999.)KNT=0
00575		KNT=KNT+1
00587	C COUNTER IS TO 0 1ST CELL OF DPPLR ARRAY(SPD IS NOT KNOWN YET)
00600		IF(NL.EQ.-14.OR.NL.EQ.-16)GO TO 1
00700	C   -14 OR -16=X,Y SYSTEM
00800		DG=P(IPAR-4)
00900	C   DG=DEGREES
01500		DIS=P(IPAR-3)
01600	C   RADIUS OF CIRCLE
01700		XX=P(IPAR-2)
01800		YY=P(IPAR-1)
01900	C   XX,YY IS CENTER OF CIRCLE
02000		X=DIS*SIND(DG)+XX
02100		Y=DIS*COSD(DG)+YY
02920		XF=X
02960		YF=Y
03000		GO TO 10
03100	
03200	1	X=P(IPAR-4)
03300		Y=P(IPAR-3)
03400		XF=X
03500		YF=Y
03550	C   XF AND YF SAVE COORDS FOR SHOWING PATH ON DPY.
03600	10	DIS=SQRT(X**2+Y**2)
03700	C   DIST. OF SOUND FROM LISTENER
03750		IQUAD=1
03800		S=X
03900		T=Y
04000		XX=ABS(X)
04100		YY=ABS(Y)
04200	C   NEXT FINDS QUADRANT
04300		IF(X.LT.YY)GO TO 7
04400		IQUAD=2
04500		S=-Y
04600		T=X
04700		GO TO 3
04800	7	IF(-Y.LT.XX)GO TO 8
04900		IQUAD=3
05000		S=-X
05100		T=-Y
05200		GO TO 3
05300	8	IF(-X.LE.YY)GO TO 3
05400		IQUAD=4
05500		S=Y
05600		T=-X
05700	3	XA=.5-S/(T*2)
05800		XB=1-XA
05900	C   % OF SNUND IN EACH "FRONT" SPEAKER
06000		IF(DIS.GE.SQ200)GO TO 30
06100	C   OUTSIDE OF SPEAKER CIRCLE, THEN JUMP
06150	CC	X=1-DIS/SQ200
06200		X=(1-DIS/SQ200)**2
06300	C   FACTOR (OR TRY? (1-DIS/SQ200)**2  )
06400		XA=XA+(1-XA)*X
06500		XB=XB+(1-XB)*X
06600		XC=XB*X
06700		XD=XA*X
06710	CV	Q=ABS(S)
06720	CV	B=(T+ABS(S))/2.
06730	CV	Q=1-SQRT((B-S)**2+(B-T)**2)/SQ200
06740	CV	R=1-SQRT(2*B**2)/SQ200
06750	CV	IF(S.LT.0)GO TO 32
06760	CV	XA=Q
06770	CV	XB=R
06780	CV	GO TO 33
06790	CV32	XA=R
06800	CV	XB=S
06802	CV33	U=(T+10)**2
06806	CV	V=1-DIS/SQ200
06810	CV	XC=V*SQ200/SQRT((10.-S)**2+U)
06815	C  FINDS DIST TO SPEAKER.
06820	CV	XD=V*SQ200/SQRT((10.+S)**2+U)
06900		GO TO 31
06990	C   SUM OF FACTORS WILL BE FROM 1(AT EDGE) TO 4(AT CENTER)
07000	30	X=1-((DIS-SQ200)/DIS)**2
07100	C   OUTSIDE CIRCLE (TRY ALSO SANS **)
07200		XA=XA*X
07300		XB=XB*X
07400	31	N=IPAR-5
07500		IQUAD=IQUAD-1
07600		DO 2 K=1,4
07700		J=IQUAD+K
07800		IF(J.GT.4)J=J-4
07900	2	P(J+N)=FAC(K)
08000	C  SETS DIR. SIG. MULTIPLIERS FOR EACH SPKR
08010		T=P(1)-TIME1
08020		V=(DIS1-DIS)/T
08030		P(IPAR)=DIS1/(DIS1-V)
08040	C   P(IPAR) IS FREQ MULTIPLIER FOR DOPPLER SHIFT
08050		TIME1=P(1)
08060		DIS1=DIS
08070	C   SAVE DIS AND TIME FOR NEXT TIME AROUND
08100		IF(KNT.EQ.1)P(IPAR)=0
08110	C   ZERO FREQ MULTIPLIER FIRST TIME.
08120	C   IN FUNCTION IT WILL BE MADE EQUAL TO SECOND SLOT
08200		RETURN
08300		END
08400	C   CAN BE USED FOR 2 CHANS.  BUT 5 PARAMS STILL NEEDED.